Delphi Informant Complete 1995 - 2000/Delphi Informant Complete 1995 to 2000.iso/Delphi Informant Magazine Complete Works SOURCE CODE 1998.rar/1998/Mar/di9803cc/MMButton.pas

Pascal/Delphi Source File | 1997-07-22 | 7KB | 245 lines

unit MMButton;

interface

uses
  Windows, Messages, Classes, Graphics, Controls;

type
  TSoundType = (stAppResource, stDLLResource, stFile);
  TMMButton = class(TGraphicControl)
  private
    { Private declarations }
    FBmpNormal,
    FBmpHiLight,
    FBmpPushed,
    FBmpDisabled      : TBitmap;

    FSndOver,
    FSndPush          : string;

    FSoundType        : TSoundType;
    FDllInstance      : integer;

    FDown,
    FOver             : Boolean;

    procedure setNormal(Value : TBitMap);
    procedure setHiLight(Value : TBitMap);
    procedure setPushed(Value : TBitMap);
    procedure setDisabled(Value : TBitmap);
    procedure doSound(whichSound: string);
  protected
    { Protected declarations }
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure Paint; override;
    procedure Click; override;

  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
    property PicNormal   : TBitMap read FBmpNormal write setNormal;
    property PicHiLight  : TBitMap read FBmpHiLight write setHiLight;
    property PicPushed   : TBitMap read FBmpPushed write setPushed;
    property PicDisabled : TBitmap read FBmpDisabled write setDisabled;

    property SndOver     : string read FSndOver write FSndOver;
    property SndPush     : string read FSndPush write FSndPush;
    property SoundType   : TSoundType read FSoundType write FSoundType;
    property DLLInst     : integer read FDLLInstance write FDLLInstance;

    property Height default 30;
    property Width default 30;

    property Enabled;
    property Visible;

    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnClick;

  end; //TMMButton

procedure Register;

implementation
uses
  MMSystem;

procedure Register;
  begin
    RegisterComponents('Additional', [TMMButton]);
  end; //Register

constructor TMMButton.Create(AOwner: TComponent);
  begin
    inherited Create(AOwner);
    Width := 30;
    Height := 30;
    FBmpNormal  := TBitMap.Create;
    FBmpHiLight := TBitmap.Create;
    FBmpPushed  := TBitmap.Create;
    FBmpDisabled := TBitmap.Create;
    FSoundType := stAppResource;
    FDLLInstance := 0;
  end;

destructor TMMButton.Destroy;
  begin
    FBmpNormal.Free;
    FBmpHiLight.Free;
    FBmpPushed.Free;
    FBmpDisabled.Free;
    inherited Destroy;
  end;

procedure TMMButton.setNormal(Value: TBitMap);
  begin
    FBmpNormal.Assign(Value);
    if not FBmpNormal.Empty then begin
      //  Set the height and width of the component based on the
      //  size of the Normal bitmap
      Height := FBmpNormal.Height;
      Width := FBmpNormal.Width;
      FBmpNormal.PaletteModified := True;
      end;
  end; //setNormal

procedure TMMButton.setHiLight(Value: TBitMap);
  begin
    FBmpHiLight.Assign(Value);
  end; //setHiLight

procedure TMMButton.setPushed(Value: TBitMap);
  begin
    FBmpPushed.Assign(Value);
  end; //setPushed

procedure TMMButton.setDisabled(Value: TBitMap);
  begin
    FBmpDisabled.Assign(Value);
  end; //setDisabled

procedure TMMButton.doSound(whichSound : string);
  begin
    case FSoundType of
      stAppResource : PlaySound(PChar(whichSound), hInstance, SND_RESOURCE or SND_ASYNC or SND_NODEFAULT);
      stDLLResource : PlaySound(PChar(whichSound), FDLLInstance, SND_RESOURCE or SND_ASYNC or SND_NODEFAULT);
      stFile        : PlaySound(PChar(whichSound), 0, SND_FILENAME or SND_ASYNC or SND_NODEFAULT);
    end; //case
  end; //doSound

procedure TMMButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
  begin
    FDown := True;
    doSound(FSndPush);
    if Not FBmpPushed.Empty then Paint;
    inherited MouseDown(Button, Shift, X, Y);
  end; //MouseDown

procedure TMMButton.CMMouseEnter(var Message: TMessage);
  begin
    FOver := True;
    doSound(FSndOver);
    if (Not FBmpHiLight.Empty) or FDown then Paint;
  end; //CMMouseEnter

procedure TMMButton.CMMouseLeave(var Message: TMessage);
  begin
    FOver := False;
    if (Not FBmpHiLight.Empty) or FDown then Paint;
  end; //CMMouseLeave

procedure TMMButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
  var
    DoClick: Boolean;
  begin
    FDown := False;
    DoClick := (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight);
    if DoClick then begin
      Paint;
      If Assigned(OnClick) then OnClick(Self);
      end;
    inherited MouseUp(Button, Shift, X, Y);
  end; //MouseUp

procedure TMMButton.Click;
  begin
  end; //Click

// On 7/14/97, I added 7 lines of code to the paint method to allow the bitmaps colors to
// be displayed correctly on a machine showing only 256 colors.
//
// Robert Vivrette - [e-mail]

procedure TMMButton.Paint;
  var
    ARect : TRect;
    Src   : TBitMap;
    OldPal : HPalette;                                                          // RLV - 7/14/97

  begin
    OldPal := SelectPalette(Canvas.Handle,FBmpNormal.Palette,False);            // RLV - 7/14/97
    try                                                                         // RLV - 7/14/97
      RealizePalette(Canvas.Handle);                                            // RLV - 7/14/97

      ARect := Rect(0,0,Width,Height);
      if (csDesigning in ComponentState) then

        //Design-time paint response
        if FBmpNormal.Empty then begin
          //add visibility when designing
          with Canvas.Pen do begin
            Style := psSolid;
            Color := clGray;
            Mode :=  pmXor;
            end;
          Canvas.Brush.Style := bsClear;
          Canvas.Rectangle(0, 0, Width, Height);
          end
        else
          Canvas.CopyRect(ARect, FBmpNormal.Canvas, ARect)

      else begin  //Run-time paint response

        // Check the button state & assign the appropriate bitmap
        if not Enabled then
          Src := FBmpDisabled
        else
          if not FOver then
            Src := FBmpNormal
          else
            if FDown then
              Src := FBmpPushed
            else
              Src := FBmpHiLight;

        // catch all if the Src bitmap is not valid at this point, paint
        // the normal bitmap.
        if Src.Empty and (Not FBmpNormal.Empty) then
          Src := FBmpNormal;

        // Paint the component's canvas
        if not Src.Empty then
          Canvas.CopyRect(ARect, Src.Canvas, ARect);

        end
    finally                                                                     // RLV - 7/14/97
      if OldPal <> 0 then                                                       // RLV - 7/14/97
        SelectPalette(Canvas.Handle,OldPal,False);                              // RLV - 7/14/97
    end;
  end; //Paint

end.